g2 <- pareto.bets[bet.pair[2],2]
# Add the two non-dominated options
bets <- data.frame(prob = c(p1, p2), gain = c(g1, g2), pareto = c(T, T))
# Decide on how many distractor bets to add where
rndint <- function (range) {floor(runif(n = 1, min = range[1], max = range[2] + 1))}
r1c <- rndint(r1.count)
r2c <- rndint(r2.count)
r12c <- rndint(r12.count)
# Add distractor bets
overlaps <- function(bets, prob, gain) {
prob.length <- prob.limits[2] - prob.limits[1]
gain.length <- gain.limits[2] - gain.limits[1]
d2 <- ((bets$prob - prob) / prob.length) ^ 2 + ((bets$gain - gain) / gain.length) ^ 2
return (min(d2) < point.size ^ 2)
}
add.bets.uniform <- function(bets, prob.range, gain.range, count) {
if (count == 0) return(bets)
for (i in 1:count) {
overlap <- T
while(overlap) {
prob <- runif(n = 1, min = prob.range[1], max = prob.range[2])
gain <- runif(n = 1, min = gain.range[1], max = gain.range[2])
overlap <- overlaps(bets, prob, gain)
}
bets <- rbind(bets, data.frame(prob = prob, gain = gain, pareto = F))
}
bets
}
bets <- add.bets.uniform(bets, c(0, p1), c(g2, g1), r1c)
bets <- add.bets.uniform(bets, c(p1, p2), c(0, g2), r2c)
bets <- add.bets.uniform(bets, c(0, p1), c(0, g2), r12c)
bets_0 <- bets
# Loop over decoy positions
for (decoy.position in 1:2) {
# Give a name to the gamble
bet1.name <- pareto.bets.names[all.gambles.nodecoy[1,g]]
bet2.name <- pareto.bets.names[all.gambles.nodecoy[2,g]]
if (decoy.position == 1) {
gamble.name <- paste(bet1.name, bet2.name, sep="")
} else {
gamble.name <- paste(bet2.name, bet1.name, sep="")
}
cat(gamble.name, "\n")
# Retreive bet without decoys
bets <- bets_0
# Decide on how many decoys to add
dc <- rndint(decoy.count)
# Add decoys
if (decoy.position == 1) {
prob.lower.limit <- 0
prob.upper.limit <- p1
prob.mode <- p1 * decoy.triangular.mode
prob.mean <- p1 * decoy.halfnormal.mean
gain.lower.limit <- g2
gain.upper.limit <- g1
gain.mode <- g1 * decoy.triangular.mode
gain.mean <- g2 + (g1 - g2) * decoy.halfnormal.mean
} else {
d.prob.range <- c(p1, p2)
d.gain.range <- c(0, g2)
prob.lower.limit <- p1
prob.upper.limit <- p2
prob.mode <- p2 * decoy.triangular.mode
prob.mean <- p1 + (p2 - p1) * decoy.halfnormal.mean
gain.lower.limit <- 0
gain.upper.limit <- g2
gain.mode <- g2 * decoy.triangular.mode
gain.mean <- g2 * decoy.halfnormal.mean
}
library(triangle)
library(fdrtool)
for (i in 1:dc) {
ok <- F
while(!ok) {
if (triangular) {
# Use a triangular probability distribution
prob <- rtriangle(1, a = prob.lower.limit, b = prob.upper.limit, c = prob.mode)
gain <- rtriangle(1, a = gain.lower.limit, b = gain.upper.limit, c = gain.mode)
ok <- T
} else {
# Use a half-normal probability distribution
prob.theta <- 1 / (prob.upper.limit - prob.mean)
prob <- prob.upper.limit - rhalfnorm(1, theta = prob.theta)
gain.theta <- 1 / (gain.upper.limit - gain.mean)
gain <- gain.upper.limit - rhalfnorm(1, theta = gain.theta)
ok <- prob >= prob.lower.limit && gain >= gain.lower.limit
}
ok <- ok && !overlaps(bets, prob, gain)
}
bets <- rbind(bets, data.frame(prob = prob, gain = gain, pareto = F))
}
# Plot the result
plotbets <- function(bets) {
plot(x = bets$prob, y = bets$gain,
xlim = prob.limits, xlab = gamble.name,
ylim = gain.limits, ylab = "",
col=rgb(0.0, 0.0, 0.0, 1.0), pch=20, cex=point.size * 90)
}
plotbets(bets)
####### Update anthi's table
dominated.bets <- bets[-2:-1,] # remove first two rows
n <- nrow(dominated.bets)
first.id <- anthi.id + 1
last.id <- anthi.id + n
add.anthi.table <- data.frame(
id = first.id:last.id,
set.name = 'GAMBLES_PROBABILITY_MONEY',
ticket.name =  sapply(first.id:last.id, function(x) {paste('Gamble', x)}),
prob = dominated.bets[,1],
gain = dominated.bets[,2],
x_ = 0,
y_ = 0,
gamble.name = gamble.name
)
anthi.id <- last.id
add.anthi.table
####### Write individual csv file
csv <- data.frame(x = round(bets$prob, digits = 4), y = round(bets$gain, digits=4))
csv$choice <- ifelse(csv$x == p1 & csv$y == g1, 1, ifelse(csv$x == p2 & csv$y == g2, 2, 0))
filename <- paste(gamble.name, '.csv', sep='')
write.csv(csv, filename, row.names = FALSE)
}
}
add.anthi.table
total <- rbind(anthi.table, add.anthi.table)
total
match("A", pareto.bet.names)
match("A", pareto.bets.names)
substr("AB", 1, 1)
# All formally uncomparable bets that can be either targets or competitors
pareto.bets <- data.frame(
prob = c(.83, .67, .5, .4, .3, .25),
gain = c(12, 15, 20, 25, 33, 40)) # Should be ordered increasingly
pareto.bets.names <- c("A", "B", "C", "D", "E", "F")
# Threshold for removing gambles involving similar bets, as measured by their position
# in the list. For example, minBetDistance <- 1 will not remove any bet, whereas
# minBetDistance <- 2 will remove all adjacent bets (e.g., AB, CD, ED, etc.).
minBetDistance <- 2
# Axis limits for the plot
prob.limits <- c(0, 1)
gain.limits <- c(0, 40)
# Point size for overlap prevention, as a multiple of axis length
point.size <- 0.025
# Minimum and maximum number of distractor bets in regions R1, R2 and R12 (see our paper)
r1.count <- c(1, 2)
r2.count <- c(1, 2)
r12.count <- c(1, 2)
# Minimum and maximum number of decoys
decoy.count <- c(10, 20)
# Mode of the triangular distribution for choosing random decoys, expressed as a
# multiple of the target's attribute value.
# Wedell's decoy positions are 0.875, 0.9, 0.925, 0.94 for probability
# and 0.8, 0.9, 0.87, 0.83 for gain
decoy.triangular.mode <- 0.95
# Mean of the half-normal distribution, expressed as a multiple of the range
# available on the axis.
decoy.halfnormal.mean <- 0.7
# Choose distribution: T for triangular, F for half-normal
triangular <- F
# For replicability
set.seed(0)
#############
# Prepare data frame using anthi's format. First add all no-decoy bets.
n <- length(pareto.bets.names)
anthi.table <- data.frame(
id = 1:n,
set.name = 'GAMBLES_PROBABILITY_MONEY',
ticket.name =  sapply(1:n, function(x) {paste('Gamble', x)}),
prob = pareto.bets[,1],
gain = pareto.bets[,2],
x_ = 0,
y_ = 0,
gamble.name = pareto.bets.names
)
anthi.id <- n
###
par(mfrow=c(4,5))
# Generate all gambles without decoys. The first number should always be higher than
# the second.
nbets <- nrow(pareto.bets)
all.gambles.nodecoy <- combn(1:nbets, 2, FUN = rev)
# Remove gambles involving bets that are too similar, wrt their position in the list.
distance <- abs(all.gambles.nodecoy[1,]-all.gambles.nodecoy[2,])
keep <- distance >= minBetDistance
all.gambles.nodecoy <- all.gambles.nodecoy[,keep]
# Loop over all gambles
ngambles.nodecoy <- ncol(all.gambles.nodecoy)
for (g in 1:ngambles.nodecoy) {
bet.pair <- c(all.gambles.nodecoy[1,g], all.gambles.nodecoy[2,g])
p1 <- pareto.bets[bet.pair[1],1]
g1 <- pareto.bets[bet.pair[1],2]
p2 <- pareto.bets[bet.pair[2],1]
g2 <- pareto.bets[bet.pair[2],2]
# Add the two non-dominated options
bets <- data.frame(prob = c(p1, p2), gain = c(g1, g2), pareto = c(T, T))
# Decide on how many distractor bets to add where
rndint <- function (range) {floor(runif(n = 1, min = range[1], max = range[2] + 1))}
r1c <- rndint(r1.count)
r2c <- rndint(r2.count)
r12c <- rndint(r12.count)
# Add distractor bets
overlaps <- function(bets, prob, gain) {
prob.length <- prob.limits[2] - prob.limits[1]
gain.length <- gain.limits[2] - gain.limits[1]
d2 <- ((bets$prob - prob) / prob.length) ^ 2 + ((bets$gain - gain) / gain.length) ^ 2
return (min(d2) < point.size ^ 2)
}
add.bets.uniform <- function(bets, prob.range, gain.range, count) {
if (count == 0) return(bets)
for (i in 1:count) {
overlap <- T
while(overlap) {
prob <- runif(n = 1, min = prob.range[1], max = prob.range[2])
gain <- runif(n = 1, min = gain.range[1], max = gain.range[2])
overlap <- overlaps(bets, prob, gain)
}
bets <- rbind(bets, data.frame(prob = prob, gain = gain, pareto = F))
}
bets
}
bets <- add.bets.uniform(bets, c(0, p1), c(g2, g1), r1c)
bets <- add.bets.uniform(bets, c(p1, p2), c(0, g2), r2c)
bets <- add.bets.uniform(bets, c(0, p1), c(0, g2), r12c)
bets_0 <- bets
# Loop over decoy positions
for (decoy.position in 1:2) {
# Give a name to the gamble
bet1.name <- pareto.bets.names[all.gambles.nodecoy[1,g]]
bet2.name <- pareto.bets.names[all.gambles.nodecoy[2,g]]
if (decoy.position == 1) {
gamble.name <- paste(bet1.name, bet2.name, sep="")
} else {
gamble.name <- paste(bet2.name, bet1.name, sep="")
}
cat(gamble.name, "\n")
# Retreive bet without decoys
bets <- bets_0
# Decide on how many decoys to add
dc <- rndint(decoy.count)
# Add decoys
if (decoy.position == 1) {
prob.lower.limit <- 0
prob.upper.limit <- p1
prob.mode <- p1 * decoy.triangular.mode
prob.mean <- p1 * decoy.halfnormal.mean
gain.lower.limit <- g2
gain.upper.limit <- g1
gain.mode <- g1 * decoy.triangular.mode
gain.mean <- g2 + (g1 - g2) * decoy.halfnormal.mean
} else {
d.prob.range <- c(p1, p2)
d.gain.range <- c(0, g2)
prob.lower.limit <- p1
prob.upper.limit <- p2
prob.mode <- p2 * decoy.triangular.mode
prob.mean <- p1 + (p2 - p1) * decoy.halfnormal.mean
gain.lower.limit <- 0
gain.upper.limit <- g2
gain.mode <- g2 * decoy.triangular.mode
gain.mean <- g2 * decoy.halfnormal.mean
}
library(triangle)
library(fdrtool)
for (i in 1:dc) {
ok <- F
while(!ok) {
if (triangular) {
# Use a triangular probability distribution
prob <- rtriangle(1, a = prob.lower.limit, b = prob.upper.limit, c = prob.mode)
gain <- rtriangle(1, a = gain.lower.limit, b = gain.upper.limit, c = gain.mode)
ok <- T
} else {
# Use a half-normal probability distribution
prob.theta <- 1 / (prob.upper.limit - prob.mean)
prob <- prob.upper.limit - rhalfnorm(1, theta = prob.theta)
gain.theta <- 1 / (gain.upper.limit - gain.mean)
gain <- gain.upper.limit - rhalfnorm(1, theta = gain.theta)
ok <- prob >= prob.lower.limit && gain >= gain.lower.limit
}
ok <- ok && !overlaps(bets, prob, gain)
}
bets <- rbind(bets, data.frame(prob = prob, gain = gain, pareto = F))
}
# Plot the result
plotbets <- function(bets) {
plot(x = bets$prob, y = bets$gain,
xlim = prob.limits, xlab = gamble.name,
ylim = gain.limits, ylab = "",
col=rgb(0.0, 0.0, 0.0, 1.0), pch=20, cex=point.size * 90)
}
plotbets(bets)
####### Update anthi's table
dominated.bets <- bets[-2:-1,] # remove first two rows
n <- nrow(dominated.bets)
first.id <- anthi.id + 1
last.id <- anthi.id + n
target.index <- match(substr(gamble.name, 1, 1), pareto.bets.names)
add.anthi.table <- data.frame(
id = first.id:last.id,
set.name = 'GAMBLES_PROBABILITY_MONEY',
ticket.name =  sapply(first.id:last.id, function(x) {paste('Gamble', x)}),
prob = dominated.bets[,1],
gain = dominated.bets[,2],
isdecoy = 1,
target.index = target.index,
gamble.name = gamble.name
)
anthi.id <- last.id
anthi.table <- rbind(anthi.table, add.anthi.table)
####### Write individual csv file
csv <- data.frame(x = round(bets$prob, digits = 4), y = round(bets$gain, digits=4))
csv$choice <- ifelse(csv$x == p1 & csv$y == g1, 1, ifelse(csv$x == p2 & csv$y == g2, 2, 0))
filename <- paste(gamble.name, '.csv', sep='')
write.csv(csv, filename, row.names = FALSE)
}
}
# All formally uncomparable bets that can be either targets or competitors
pareto.bets <- data.frame(
prob = c(.83, .67, .5, .4, .3, .25),
gain = c(12, 15, 20, 25, 33, 40)) # Should be ordered increasingly
pareto.bets.names <- c("A", "B", "C", "D", "E", "F")
# Threshold for removing gambles involving similar bets, as measured by their position
# in the list. For example, minBetDistance <- 1 will not remove any bet, whereas
# minBetDistance <- 2 will remove all adjacent bets (e.g., AB, CD, ED, etc.).
minBetDistance <- 2
# Axis limits for the plot
prob.limits <- c(0, 1)
gain.limits <- c(0, 40)
# Point size for overlap prevention, as a multiple of axis length
point.size <- 0.025
# Minimum and maximum number of distractor bets in regions R1, R2 and R12 (see our paper)
r1.count <- c(1, 2)
r2.count <- c(1, 2)
r12.count <- c(1, 2)
# Minimum and maximum number of decoys
decoy.count <- c(10, 20)
# Mode of the triangular distribution for choosing random decoys, expressed as a
# multiple of the target's attribute value.
# Wedell's decoy positions are 0.875, 0.9, 0.925, 0.94 for probability
# and 0.8, 0.9, 0.87, 0.83 for gain
decoy.triangular.mode <- 0.95
# Mean of the half-normal distribution, expressed as a multiple of the range
# available on the axis.
decoy.halfnormal.mean <- 0.7
# Choose distribution: T for triangular, F for half-normal
triangular <- F
# For replicability
set.seed(0)
#############
# Prepare data frame using anthi's format. First add all no-decoy bets.
n <- length(pareto.bets.names)
anthi.table <- data.frame(
id = 1:n,
set.name = 'GAMBLES_PROBABILITY_MONEY',
ticket.name =  sapply(1:n, function(x) {paste('Gamble', x)}),
prob = pareto.bets[,1],
gain = pareto.bets[,2],
isdecoy = 0,
target.index = 0,
gamble.name = pareto.bets.names
)
anthi.id <- n
###
par(mfrow=c(4,5))
# Generate all gambles without decoys. The first number should always be higher than
# the second.
nbets <- nrow(pareto.bets)
all.gambles.nodecoy <- combn(1:nbets, 2, FUN = rev)
# Remove gambles involving bets that are too similar, wrt their position in the list.
distance <- abs(all.gambles.nodecoy[1,]-all.gambles.nodecoy[2,])
keep <- distance >= minBetDistance
all.gambles.nodecoy <- all.gambles.nodecoy[,keep]
# Loop over all gambles
ngambles.nodecoy <- ncol(all.gambles.nodecoy)
for (g in 1:ngambles.nodecoy) {
bet.pair <- c(all.gambles.nodecoy[1,g], all.gambles.nodecoy[2,g])
p1 <- pareto.bets[bet.pair[1],1]
g1 <- pareto.bets[bet.pair[1],2]
p2 <- pareto.bets[bet.pair[2],1]
g2 <- pareto.bets[bet.pair[2],2]
# Add the two non-dominated options
bets <- data.frame(prob = c(p1, p2), gain = c(g1, g2), pareto = c(T, T))
# Decide on how many distractor bets to add where
rndint <- function (range) {floor(runif(n = 1, min = range[1], max = range[2] + 1))}
r1c <- rndint(r1.count)
r2c <- rndint(r2.count)
r12c <- rndint(r12.count)
# Add distractor bets
overlaps <- function(bets, prob, gain) {
prob.length <- prob.limits[2] - prob.limits[1]
gain.length <- gain.limits[2] - gain.limits[1]
d2 <- ((bets$prob - prob) / prob.length) ^ 2 + ((bets$gain - gain) / gain.length) ^ 2
return (min(d2) < point.size ^ 2)
}
add.bets.uniform <- function(bets, prob.range, gain.range, count) {
if (count == 0) return(bets)
for (i in 1:count) {
overlap <- T
while(overlap) {
prob <- runif(n = 1, min = prob.range[1], max = prob.range[2])
gain <- runif(n = 1, min = gain.range[1], max = gain.range[2])
overlap <- overlaps(bets, prob, gain)
}
bets <- rbind(bets, data.frame(prob = prob, gain = gain, pareto = F))
}
bets
}
bets <- add.bets.uniform(bets, c(0, p1), c(g2, g1), r1c)
bets <- add.bets.uniform(bets, c(p1, p2), c(0, g2), r2c)
bets <- add.bets.uniform(bets, c(0, p1), c(0, g2), r12c)
bets_0 <- bets
# Loop over decoy positions
for (decoy.position in 1:2) {
# Give a name to the gamble
bet1.name <- pareto.bets.names[all.gambles.nodecoy[1,g]]
bet2.name <- pareto.bets.names[all.gambles.nodecoy[2,g]]
if (decoy.position == 1) {
gamble.name <- paste(bet1.name, bet2.name, sep="")
} else {
gamble.name <- paste(bet2.name, bet1.name, sep="")
}
cat(gamble.name, "\n")
# Retreive bet without decoys
bets <- bets_0
# Decide on how many decoys to add
dc <- rndint(decoy.count)
# Add decoys
if (decoy.position == 1) {
prob.lower.limit <- 0
prob.upper.limit <- p1
prob.mode <- p1 * decoy.triangular.mode
prob.mean <- p1 * decoy.halfnormal.mean
gain.lower.limit <- g2
gain.upper.limit <- g1
gain.mode <- g1 * decoy.triangular.mode
gain.mean <- g2 + (g1 - g2) * decoy.halfnormal.mean
} else {
d.prob.range <- c(p1, p2)
d.gain.range <- c(0, g2)
prob.lower.limit <- p1
prob.upper.limit <- p2
prob.mode <- p2 * decoy.triangular.mode
prob.mean <- p1 + (p2 - p1) * decoy.halfnormal.mean
gain.lower.limit <- 0
gain.upper.limit <- g2
gain.mode <- g2 * decoy.triangular.mode
gain.mean <- g2 * decoy.halfnormal.mean
}
library(triangle)
library(fdrtool)
for (i in 1:dc) {
ok <- F
while(!ok) {
if (triangular) {
# Use a triangular probability distribution
prob <- rtriangle(1, a = prob.lower.limit, b = prob.upper.limit, c = prob.mode)
gain <- rtriangle(1, a = gain.lower.limit, b = gain.upper.limit, c = gain.mode)
ok <- T
} else {
# Use a half-normal probability distribution
prob.theta <- 1 / (prob.upper.limit - prob.mean)
prob <- prob.upper.limit - rhalfnorm(1, theta = prob.theta)
gain.theta <- 1 / (gain.upper.limit - gain.mean)
gain <- gain.upper.limit - rhalfnorm(1, theta = gain.theta)
ok <- prob >= prob.lower.limit && gain >= gain.lower.limit
}
ok <- ok && !overlaps(bets, prob, gain)
}
bets <- rbind(bets, data.frame(prob = prob, gain = gain, pareto = F))
}
# Plot the result
plotbets <- function(bets) {
plot(x = bets$prob, y = bets$gain,
xlim = prob.limits, xlab = gamble.name,
ylim = gain.limits, ylab = "",
col=rgb(0.0, 0.0, 0.0, 1.0), pch=20, cex=point.size * 90)
}
plotbets(bets)
####### Update anthi's table
dominated.bets <- bets[-2:-1,] # remove first two rows
n <- nrow(dominated.bets)
first.id <- anthi.id + 1
last.id <- anthi.id + n
target.index <- match(substr(gamble.name, 1, 1), pareto.bets.names)
add.anthi.table <- data.frame(
id = first.id:last.id,
set.name = 'GAMBLES_PROBABILITY_MONEY',
ticket.name =  sapply(first.id:last.id, function(x) {paste('Gamble', x)}),
prob = dominated.bets[,1],
gain = dominated.bets[,2],
isdecoy = 1,
target.index = target.index,
gamble.name = gamble.name
)
anthi.id <- last.id
anthi.table <- rbind(anthi.table, add.anthi.table)
####### Write individual csv file
csv <- data.frame(x = round(bets$prob, digits = 4), y = round(bets$gain, digits=4))
csv$choice <- ifelse(csv$x == p1 & csv$y == g1, 1, ifelse(csv$x == p2 & csv$y == g2, 2, 0))
filename <- paste(gamble.name, '.csv', sep='')
write.csv(csv, filename, row.names = FALSE)
}
}
anthi.table
anthi.table
write.table(anthi.table, filename = "anthi.table.v1", sep=",", row.names = FALSE, col.names=FALSE)
write.table(anthi.table, "anthi.table.v1", sep=",", row.names = FALSE, col.names=FALSE)
source('~/Work/newdecoy/Exp 3/R scatterplot generation/bets.R')
source('~/Work/newdecoy/Exp 3/R scatterplot generation/bets.R')
source('~/Work/newdecoy/Exp 3/R scatterplot generation/bets.R')
source('~/Work/newdecoy/Exp 3/R scatterplot generation/bets.R')
source('~/Work/newdecoy/Exp 3/R scatterplot generation/bets.R')
